library(bayesm)
data(tuna)
summary(tuna)
## WEEK MOVE1 MOVE2 MOVE3
## Min. : 1.00 Min. : 4428 Min. : 2525 Min. : 8
## 1st Qu.: 85.25 1st Qu.: 8039 1st Qu.: 4628 1st Qu.:2061
## Median :169.50 Median : 10801 Median : 6633 Median :2538
## Mean :174.98 Mean : 20810 Mean : 16104 Mean :2656
## 3rd Qu.:255.75 3rd Qu.: 20326 3rd Qu.: 11176 3rd Qu.:3043
## Max. :398.00 Max. :442490 Max. :579037 Max. :9287
## MOVE4 MOVE5 MOVE6 MOVE7
## Min. : 1857 Min. : 859 Min. : 21.0 Min. : 739
## 1st Qu.: 4344 1st Qu.:2158 1st Qu.: 824.5 1st Qu.: 4277
## Median : 6216 Median :2618 Median :1044.5 Median : 6315
## Mean : 14412 Mean :2893 Mean :1056.9 Mean : 8518
## 3rd Qu.: 11235 3rd Qu.:3412 3rd Qu.:1309.0 3rd Qu.: 9044
## Max. :268543 Max. :9277 Max. :2032.0 Max. :148541
## NSALE1 NSALE2 NSALE3 NSALE4
## Min. :0.000000 Min. :0.00000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.000000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.004123 Median :0.04985 Median :0.0000 Median :0.0000
## Mean :0.306778 Mean :0.34379 Mean :0.2903 Mean :0.2332
## 3rd Qu.:0.723320 3rd Qu.:0.79179 3rd Qu.:0.7735 3rd Qu.:0.4450
## Max. :1.000000 Max. :1.00000 Max. :1.0000 Max. :1.0000
## NSALE5 NSALE6 NSALE7 LPRICE1
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :-0.83257
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:-0.29873
## Median :0.0000 Median :0.0000 Median :0.0000 Median :-0.20122
## Mean :0.3499 Mean :0.2468 Mean :0.2432 Mean :-0.22642
## 3rd Qu.:0.9383 3rd Qu.:0.5706 3rd Qu.:0.4255 3rd Qu.:-0.11968
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :-0.02891
## LPRICE2 LPRICE3 LPRICE4 LPRICE5
## Min. :-1.23787 Min. :0.4054 Min. :-0.941406 Min. :0.2003
## 1st Qu.:-0.29264 1st Qu.:0.5143 1st Qu.:-0.336132 1st Qu.:0.3505
## Median :-0.20201 Median :0.5689 Median :-0.193566 Median :0.3931
## Mean :-0.23152 Mean :0.5432 Mean :-0.240781 Mean :0.3782
## 3rd Qu.:-0.12714 3rd Qu.:0.5745 3rd Qu.:-0.118024 3rd Qu.:0.4117
## Max. :-0.08809 Max. :0.6128 Max. :-0.007572 Max. :0.4568
## LPRICE6 LPRICE7 LWHPRIC1 LWHPRIC2
## Min. :1.095 Min. :-0.7133 Min. :-1.3309 Min. :-10.4482
## 1st Qu.:1.214 1st Qu.:-0.3468 1st Qu.:-0.6553 1st Qu.: -0.6121
## Median :1.223 Median :-0.2932 Median :-0.5561 Median : -0.5377
## Mean :1.217 Mean :-0.2950 Mean :-0.5822 Mean : -0.5889
## 3rd Qu.:1.228 3rd Qu.:-0.2135 3rd Qu.:-0.5104 3rd Qu.: -0.5115
## Max. :1.258 Max. :-0.1515 Max. :-0.3887 Max. : -0.4042
## LWHPRIC3 LWHPRIC4 LWHPRIC5 LWHPRIC6
## Min. :-0.2221 Min. :-0.9858 Min. :-0.04956 Min. :0.8471
## 1st Qu.: 0.1736 1st Qu.:-0.6451 1st Qu.: 0.02371 1st Qu.:0.9188
## Median : 0.1943 Median :-0.6111 Median : 0.08328 Median :0.9353
## Mean : 0.2085 Mean :-0.5954 Mean : 0.07640 Mean :0.9470
## 3rd Qu.: 0.2386 3rd Qu.:-0.5157 3rd Qu.: 0.12043 3rd Qu.:0.9929
## Max. : 0.3660 Max. :-0.3619 Max. : 0.19314 Max. :1.0203
## LWHPRIC7 FULLCUST
## Min. :-1.0920 Min. :1094480
## 1st Qu.:-0.6743 1st Qu.:1835194
## Median :-0.6008 Median :1957102
## Mean :-0.6233 Mean :1934047
## 3rd Qu.:-0.5691 3rd Qu.:2033255
## Max. :-0.4181 Max. :2431995
# Get Log of Sales
tuna$LMOVE1 <- log(tuna$MOVE1)
tuna$LMOVE2 <- log(tuna$MOVE2)
tuna$LMOVE3 <- log(tuna$MOVE3)
tuna$LMOVE4 <- log(tuna$MOVE4)
tuna$LMOVE5 <- log(tuna$MOVE5)
tuna$LMOVE6 <- log(tuna$MOVE6)
tuna$LMOVE7 <- log(tuna$MOVE7)
# Regression for each brand's cross price elasticity
m11 <- lm(LMOVE1 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m12 <- lm(LMOVE2 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m13 <- lm(LMOVE3 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m14 <- lm(LMOVE4 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m15 <- lm(LMOVE5 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m16 <- lm(LMOVE6 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
m17 <- lm(LMOVE7 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = tuna)
# Create df of all alphas
sales_elasticity <- rbind(
m11$coefficients[2:8],
m12$coefficients[2:8],
m13$coefficients[2:8],
m14$coefficients[2:8],
m15$coefficients[2:8],
m16$coefficients[2:8],
m17$coefficients[2:8]
)
row.names(sales_elasticity) <- c('SALES1','SALES2','SALES3','SALES4','SALES5','SALES6','SALES7')
colnames(sales_elasticity) <- c('PRICE1','PRICE2','PRICE3','PRICE4','PRICE5','PRICE6','PRICE7')
sales_elasticity
## PRICE1 PRICE2 PRICE3 PRICE4 PRICE5 PRICE6
## SALES1 -4.4352160 0.65612918 -0.1210709 1.12075263 1.020969244 -0.2237643
## SALES2 1.1893444 -5.12247121 -1.3893071 1.03859100 1.011436291 0.3570374
## SALES3 0.6191724 -0.34213441 -6.4693777 -1.21735583 2.881530102 0.6614715
## SALES4 1.5162104 0.87797095 -0.4762310 -4.82814843 0.003196493 -0.8329130
## SALES5 -0.1279505 -0.17700206 0.3374364 -0.10181039 -5.135390303 0.1758392
## SALES6 0.4542741 -0.06087984 -0.9937798 -0.27264143 1.003632425 -2.6751458
## SALES7 1.0585124 0.07106119 0.8715468 -0.06796984 0.767677115 -4.3201087
## PRICE7
## SALES1 0.57197704
## SALES2 -0.05992173
## SALES3 -1.67068735
## SALES4 0.39404457
## SALES5 -0.03839874
## SALES6 -0.81014301
## SALES7 -3.20742540
library("psych")
pc.cr1 <- princomp(sales_elasticity, cor=TRUE)
devtools::install_github("vqv/ggbiplot")
## WARNING: Rtools is required to build R packages, but is not currently installed.
##
## Please download and install Rtools 4.0 from https://cran.r-project.org/bin/windows/Rtools/.
## Skipping install of 'ggbiplot' from a github remote, the SHA1 (7325e880) has not changed since last install.
## Use `force = TRUE` to force installation
library(ggbiplot)
## Loading required package: ggplot2
##
## Attaching package: 'ggplot2'
## The following objects are masked from 'package:psych':
##
## %+%, alpha
## Loading required package: plyr
## Loading required package: scales
##
## Attaching package: 'scales'
## The following objects are masked from 'package:psych':
##
## alpha, rescale
## Loading required package: grid
library(plotly)
##
## Attaching package: 'plotly'
## The following objects are masked from 'package:plyr':
##
## arrange, mutate, rename, summarise
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
p <- ggbiplot(pcobj = pc.cr1, labels=row.names(sales_elasticity))
ggplotly(p)
# Get Market Shares for each Brand
# Compute Geometric mean of sales for all brands
tuna$SALES_GEO_MEAN <- apply(tuna[,2:8], 1, function(x) (prod(x[x!=0]))^(1/sum(x!=0)))
# Ratio of each brand's sales vs. geometric mean
tuna$SHARE1 <- tuna$MOVE1 / tuna$SALES_GEO_MEAN
tuna$SHARE2 <- tuna$MOVE2 / tuna$SALES_GEO_MEAN
tuna$SHARE3 <- tuna$MOVE3 / tuna$SALES_GEO_MEAN
tuna$SHARE4 <- tuna$MOVE4 / tuna$SALES_GEO_MEAN
tuna$SHARE5 <- tuna$MOVE5 / tuna$SALES_GEO_MEAN
tuna$SHARE6 <- tuna$MOVE6 / tuna$SALES_GEO_MEAN
tuna$SHARE7 <- tuna$MOVE7 / tuna$SALES_GEO_MEAN
# Log of Shares (Will be response variable in regression)
tuna$LSHARE1 <- log(tuna$SHARE1)
tuna$LSHARE2 <- log(tuna$SHARE2)
tuna$LSHARE3 <- log(tuna$SHARE3)
tuna$LSHARE4 <- log(tuna$SHARE4)
tuna$LSHARE5 <- log(tuna$SHARE5)
tuna$LSHARE6 <- log(tuna$SHARE6)
tuna$LSHARE7 <- log(tuna$SHARE7)
# Brand Share Elasticities
# Brand 1
Share_Elasticity_B1 <- cbind(tuna$LSHARE1,tuna[,16:22])
colnames(Share_Elasticity_B1)[1] <- 'LSHARE1'
Share_Elasticity_B1$LPRICE1 <- (1-(1/7)) * Share_Elasticity_B1$LPRICE1
Share_Elasticity_B1$LPRICE2 <- (-(1/7)) * Share_Elasticity_B1$LPRICE2
Share_Elasticity_B1$LPRICE3 <- (-(1/7)) * Share_Elasticity_B1$LPRICE3
Share_Elasticity_B1$LPRICE4 <- (-(1/7)) * Share_Elasticity_B1$LPRICE4
Share_Elasticity_B1$LPRICE5 <- (-(1/7)) * Share_Elasticity_B1$LPRICE5
Share_Elasticity_B1$LPRICE6 <- (-(1/7)) * Share_Elasticity_B1$LPRICE6
Share_Elasticity_B1$LPRICE7 <- (-(1/7)) * Share_Elasticity_B1$LPRICE7
# Brand 2
Share_Elasticity_B2 <- cbind(tuna$LSHARE2,tuna[,16:22])
colnames(Share_Elasticity_B2)[1] <- 'LSHARE2'
Share_Elasticity_B2$LPRICE1 <- (-(1/7)) * Share_Elasticity_B2$LPRICE1
Share_Elasticity_B2$LPRICE2 <- (1-(1/7)) * Share_Elasticity_B2$LPRICE2
Share_Elasticity_B2$LPRICE3 <- (-(1/7)) * Share_Elasticity_B2$LPRICE3
Share_Elasticity_B2$LPRICE4 <- (-(1/7)) * Share_Elasticity_B2$LPRICE4
Share_Elasticity_B2$LPRICE5 <- (-(1/7)) * Share_Elasticity_B2$LPRICE5
Share_Elasticity_B2$LPRICE6 <- (-(1/7)) * Share_Elasticity_B2$LPRICE6
Share_Elasticity_B2$LPRICE7 <- (-(1/7)) * Share_Elasticity_B2$LPRICE7
# Brand 3
Share_Elasticity_B3 <- cbind(tuna$LSHARE3,tuna[,16:22])
colnames(Share_Elasticity_B3)[1] <- 'LSHARE3'
Share_Elasticity_B3$LPRICE1 <- (-(1/7)) * Share_Elasticity_B3$LPRICE1
Share_Elasticity_B3$LPRICE2 <- (-(1/7)) * Share_Elasticity_B3$LPRICE2
Share_Elasticity_B3$LPRICE3 <- (1-(1/7)) * Share_Elasticity_B3$LPRICE3
Share_Elasticity_B3$LPRICE4 <- (-(1/7)) * Share_Elasticity_B3$LPRICE4
Share_Elasticity_B3$LPRICE5 <- (-(1/7)) * Share_Elasticity_B3$LPRICE5
Share_Elasticity_B3$LPRICE6 <- (-(1/7)) * Share_Elasticity_B3$LPRICE6
Share_Elasticity_B3$LPRICE7 <- (-(1/7)) * Share_Elasticity_B3$LPRICE7
# Brand 4
Share_Elasticity_B4 <- cbind(tuna$LSHARE4,tuna[,16:22])
colnames(Share_Elasticity_B4)[1] <- 'LSHARE4'
Share_Elasticity_B4$LPRICE1 <- (-(1/7)) * Share_Elasticity_B4$LPRICE1
Share_Elasticity_B4$LPRICE2 <- (-(1/7)) * Share_Elasticity_B4$LPRICE2
Share_Elasticity_B4$LPRICE3 <- (-(1/7)) * Share_Elasticity_B4$LPRICE3
Share_Elasticity_B4$LPRICE4 <- (1-(1/7)) * Share_Elasticity_B4$LPRICE4
Share_Elasticity_B4$LPRICE5 <- (-(1/7)) * Share_Elasticity_B4$LPRICE5
Share_Elasticity_B4$LPRICE6 <- (-(1/7)) * Share_Elasticity_B4$LPRICE6
Share_Elasticity_B4$LPRICE7 <- (-(1/7)) * Share_Elasticity_B4$LPRICE7
# Brand 5
Share_Elasticity_B5 <- cbind(tuna$LSHARE5,tuna[,16:22])
colnames(Share_Elasticity_B5)[1] <- 'LSHARE5'
Share_Elasticity_B5$LPRICE1 <- (-(1/7)) * Share_Elasticity_B5$LPRICE1
Share_Elasticity_B5$LPRICE2 <- (-(1/7)) * Share_Elasticity_B5$LPRICE2
Share_Elasticity_B5$LPRICE3 <- (-(1/7)) * Share_Elasticity_B5$LPRICE3
Share_Elasticity_B5$LPRICE4 <- (-(1/7)) * Share_Elasticity_B5$LPRICE4
Share_Elasticity_B5$LPRICE5 <- (1-(1/7)) * Share_Elasticity_B5$LPRICE5
Share_Elasticity_B5$LPRICE6 <- (-(1/7)) * Share_Elasticity_B5$LPRICE6
Share_Elasticity_B5$LPRICE7 <- (-(1/7)) * Share_Elasticity_B5$LPRICE7
# Brand 6
Share_Elasticity_B6 <- cbind(tuna$LSHARE6,tuna[,16:22])
colnames(Share_Elasticity_B6)[1] <- 'LSHARE6'
Share_Elasticity_B6$LPRICE1 <- (-(1/7)) * Share_Elasticity_B6$LPRICE1
Share_Elasticity_B6$LPRICE2 <- (-(1/7)) * Share_Elasticity_B6$LPRICE2
Share_Elasticity_B6$LPRICE3 <- (-(1/7)) * Share_Elasticity_B6$LPRICE3
Share_Elasticity_B6$LPRICE4 <- (-(1/7)) * Share_Elasticity_B6$LPRICE4
Share_Elasticity_B6$LPRICE5 <- (-(1/7)) * Share_Elasticity_B6$LPRICE5
Share_Elasticity_B6$LPRICE6 <- (1-(1/7)) * Share_Elasticity_B6$LPRICE6
Share_Elasticity_B6$LPRICE7 <- (-(1/7)) * Share_Elasticity_B6$LPRICE7
# Brand 7
Share_Elasticity_B7 <- cbind(tuna$LSHARE7,tuna[,16:22])
colnames(Share_Elasticity_B7)[1] <- 'LSHARE7'
Share_Elasticity_B7$LPRICE1 <- (-(1/7)) * Share_Elasticity_B7$LPRICE1
Share_Elasticity_B7$LPRICE2 <- (-(1/7)) * Share_Elasticity_B7$LPRICE2
Share_Elasticity_B7$LPRICE3 <- (-(1/7)) * Share_Elasticity_B7$LPRICE3
Share_Elasticity_B7$LPRICE4 <- (-(1/7)) * Share_Elasticity_B7$LPRICE4
Share_Elasticity_B7$LPRICE5 <- (-(1/7)) * Share_Elasticity_B7$LPRICE5
Share_Elasticity_B7$LPRICE6 <- (-(1/7)) * Share_Elasticity_B7$LPRICE6
Share_Elasticity_B7$LPRICE7 <- (1-(1/7)) * Share_Elasticity_B7$LPRICE7
# Regression for each brand's cross price elasticity
m21 <- lm(LSHARE1 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B1)
m22 <- lm(LSHARE2 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B2)
m23 <- lm(LSHARE3 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B3)
m24 <- lm(LSHARE4 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B4)
m25 <- lm(LSHARE5 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B5)
m26 <- lm(LSHARE6 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B6)
m27 <- lm(LSHARE7 ~ LPRICE1 + LPRICE2 + LPRICE3 + LPRICE4 + LPRICE5 + LPRICE6 + LPRICE7, data = Share_Elasticity_B7)
# Create df of all alphas
share_elasticity <- rbind(
m21$coefficients[2:8],
m22$coefficients[2:8],
m23$coefficients[2:8],
m24$coefficients[2:8],
m25$coefficients[2:8],
m26$coefficients[2:8],
m27$coefficients[2:8]
)
row.names(share_elasticity) <- c('SHARE1','SHARE2','SHARE3','SHARE4','SHARE5','SHARE6','SHARE7')
colnames(share_elasticity) <- c('PRICE1','PRICE2','PRICE3','PRICE4','PRICE5','PRICE6','PRICE7')
share_elasticity
## PRICE1 PRICE2 PRICE3 PRICE4 PRICE5 PRICE6
## SHARE1 -5.220143 -8.690230 -7.393287 -12.173851 -5.593733 -5.291234
## SHARE2 -8.051063 -5.293329 1.484367 -11.598719 -5.527003 -9.356846
## SHARE3 -4.059860 -1.702385 -6.174143 4.192909 -18.617659 -11.487884
## SHARE4 -10.339126 -10.243123 -4.907166 -4.911409 1.530676 -1.027193
## SHARE5 1.170000 -2.858312 -10.602838 -3.615910 -6.250131 -8.088458
## SHARE6 -2.905571 -3.671167 -1.284325 -2.420092 -5.472376 -1.978073
## SHARE7 -7.135240 -4.594755 -14.341611 -3.852793 -3.820688 23.383177
## PRICE7
## SHARE1 -8.8243939
## SHARE2 -4.4011025
## SHARE3 6.8742568
## SHARE4 -7.5788666
## SHARE5 -4.5517635
## SHARE6 0.8504465
## SHARE7 -2.9385705
pc.cr2 <- princomp(share_elasticity, cor=TRUE)
p <- ggbiplot(pcobj = pc.cr2, labels=row.names(share_elasticity))
ggplotly(p)